home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1997 February / PC Plus Super CD (Issue 124) (PCP124-2-97) (February 1997).iso / ms / vb5cce / controls / samples / axclock / axclock.exe / Clock.ctl (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-10-25  |  15.3 KB  |  429 lines
  1. VERSION 5.00
  2. Begin VB.UserControl Clock 
  3.    AutoRedraw      =   -1  'True
  4.    ClientHeight    =   3600
  5.    ClientLeft      =   0
  6.    ClientTop       =   0
  7.    ClientWidth     =   3540
  8.    BeginProperty Font 
  9.       Name            =   "Tahoma"
  10.       Size            =   8.25
  11.       Charset         =   0
  12.       Weight          =   400
  13.       Underline       =   0   'False
  14.       Italic          =   0   'False
  15.       Strikethrough   =   0   'False
  16.    EndProperty
  17.    PropertyPages   =   "Clock.ctx":0000
  18.    ScaleHeight     =   3600
  19.    ScaleWidth      =   3540
  20.    ToolboxBitmap   =   "Clock.ctx":0004
  21.    Begin VB.Timer Timer1 
  22.       Enabled         =   0   'False
  23.       Interval        =   499
  24.       Left            =   2880
  25.       Top             =   360
  26.    End
  27.    Begin VB.Label lblNumber 
  28.       Alignment       =   2  'Center
  29.       BackStyle       =   0  'Transparent
  30.       Caption         =   "9"
  31.       BeginProperty Font 
  32.          Name            =   "Tahoma"
  33.          Size            =   12
  34.          Charset         =   0
  35.          Weight          =   400
  36.          Underline       =   0   'False
  37.          Italic          =   0   'False
  38.          Strikethrough   =   0   'False
  39.       EndProperty
  40.       Height          =   375
  41.       Index           =   3
  42.       Left            =   3000
  43.       TabIndex        =   3
  44.       Top             =   3120
  45.       Visible         =   0   'False
  46.       Width           =   495
  47.    End
  48.    Begin VB.Label lblNumber 
  49.       Alignment       =   2  'Center
  50.       BackStyle       =   0  'Transparent
  51.       Caption         =   "6"
  52.       BeginProperty Font 
  53.          Name            =   "Tahoma"
  54.          Size            =   12
  55.          Charset         =   0
  56.          Weight          =   400
  57.          Underline       =   0   'False
  58.          Italic          =   0   'False
  59.          Strikethrough   =   0   'False
  60.       EndProperty
  61.       Height          =   375
  62.       Index           =   2
  63.       Left            =   2640
  64.       TabIndex        =   2
  65.       Top             =   3120
  66.       Visible         =   0   'False
  67.       Width           =   495
  68.    End
  69.    Begin VB.Label lblNumber 
  70.       Alignment       =   2  'Center
  71.       BackStyle       =   0  'Transparent
  72.       Caption         =   "3"
  73.       BeginProperty Font 
  74.          Name            =   "Tahoma"
  75.          Size            =   12
  76.          Charset         =   0
  77.          Weight          =   400
  78.          Underline       =   0   'False
  79.          Italic          =   0   'False
  80.          Strikethrough   =   0   'False
  81.       EndProperty
  82.       Height          =   375
  83.       Index           =   1
  84.       Left            =   2280
  85.       TabIndex        =   1
  86.       Top             =   3120
  87.       Visible         =   0   'False
  88.       Width           =   495
  89.    End
  90.    Begin VB.Label lblNumber 
  91.       Alignment       =   2  'Center
  92.       BackStyle       =   0  'Transparent
  93.       Caption         =   "12"
  94.       BeginProperty Font 
  95.          Name            =   "Tahoma"
  96.          Size            =   12
  97.          Charset         =   0
  98.          Weight          =   400
  99.          Underline       =   0   'False
  100.          Italic          =   0   'False
  101.          Strikethrough   =   0   'False
  102.       EndProperty
  103.       Height          =   375
  104.       Index           =   0
  105.       Left            =   1920
  106.       TabIndex        =   0
  107.       Top             =   3120
  108.       Visible         =   0   'False
  109.       Width           =   495
  110.    End
  111.    Begin VB.Line lSecond 
  112.       BorderWidth     =   2
  113.       X1              =   1560
  114.       X2              =   600
  115.       Y1              =   1560
  116.       Y2              =   2400
  117.    End
  118.    Begin VB.Line lMinute 
  119.       BorderWidth     =   4
  120.       X1              =   1560
  121.       X2              =   1560
  122.       Y1              =   240
  123.       Y2              =   1560
  124.    End
  125.    Begin VB.Line lHour 
  126.       BorderWidth     =   5
  127.       X1              =   1560
  128.       X2              =   2160
  129.       Y1              =   1560
  130.       Y2              =   2160
  131.    End
  132.    Begin VB.Shape ClockFace 
  133.       BorderWidth     =   5
  134.       Height          =   2895
  135.       Left            =   120
  136.       Shape           =   2  'Oval
  137.       Top             =   120
  138.       Width           =   2895
  139.    End
  140. Attribute VB_Name = "Clock"
  141. Attribute VB_GlobalNameSpace = False
  142. Attribute VB_Creatable = True
  143. Attribute VB_PredeclaredId = False
  144. Attribute VB_Exposed = True
  145. Attribute VB_Description = "Analog Clock Object Browser"
  146. Option Explicit
  147. 'Generic Constants
  148. Const PI                As Double = 3.14159265358979
  149. Const TwoPI             As Double = 2 * PI
  150. Const HourRatio         As Single = 0.55            ' Size of hour hand
  151. Const MinuteRatio       As Single = 0.85            ' Size of minute hand
  152. Const SecondRatio       As Single = 0.85            ' Size of second hand
  153. 'Property Constants
  154. Const m_def_Enabled     As Boolean = False          ' Default with clock not enabled
  155. Const m_def_ShowNumbers As Boolean = False          ' Default with numbers not visible
  156. Const m_def_ShowBorder  As Boolean = True           ' Default with clock border visible
  157. Const m_def_ShowSeconds As Boolean = True           ' Default with second hand visible
  158. Const m_def_ColorBorder As Long = &H0               ' Default with color black
  159. Const m_def_ColorFace   As Long = &HFFFFFF          ' Default with color white
  160. 'Private Property Variables
  161. Private m_Enabled       As Boolean                  ' Clock enabled?
  162. Private m_ShowNumbers   As Boolean                  ' Numbers visible?
  163. Private m_ShowBorder    As Boolean                  ' Clock border visible?
  164. Private m_ShowSeconds   As Boolean                  ' Second hand visible?
  165. Private m_ColorBorder   As OLE_COLOR                ' Clock border color
  166. Private m_ColorFace     As OLE_COLOR                ' Clock face color
  167. Private m_Picture       As StdPicture               ' Clock picture
  168. Private m_URLPicture    As String                   ' URL address
  169. 'Private Generic Variables
  170. Private HalfX           As Long                     ' X-direction center of control
  171. Private HalfY           As Long                     ' Y-direction center of control
  172. Private CurrentTime     As String                   ' Current time
  173. Private OldTime         As String                   ' Old time holder
  174. 'Initialize Properties for User Control
  175. Private Sub UserControl_InitProperties()
  176.     m_ShowNumbers = m_def_ShowNumbers
  177.     m_ShowBorder = m_def_ShowBorder
  178.     m_ShowSeconds = m_def_ShowSeconds
  179.     m_ColorBorder = m_def_ColorBorder
  180.     m_ColorFace = m_def_ColorFace
  181.     OldTime = Format(Now, "hhmmss")
  182. End Sub
  183. Private Sub Timer1_Timer()
  184.     CurrentTime = Format(Now, "hhmmss")
  185.         
  186. '   If the time hasn't changed, don't need to update clock
  187.     If CurrentTime = OldTime Then
  188.         Exit Sub
  189.     Else
  190.         DrawHands (CurrentTime)
  191.         OldTime = CurrentTime
  192.     End If
  193. End Sub
  194. Private Sub UserControl_Resize()
  195.     Timer1.Enabled = False
  196.     ClockFace.Move ScaleWidth * 0.01, ScaleHeight * 0.01, ScaleWidth * 0.98, ScaleHeight * 0.98
  197.     HalfX = ScaleWidth / 2
  198.     HalfY = ScaleHeight / 2
  199.     CurrentTime = Format(Now, "hhmmss")
  200.     DrawHands (CurrentTime)
  201.     If m_ShowNumbers Then PlaceNumbers
  202. '   Repaint picture, if needed
  203.     UserControl_Paint
  204.     Timer1.Enabled = m_Enabled
  205. End Sub
  206. Private Sub UserControl_Paint()
  207. '   Don't need to draw if picture is invalid
  208.     If (m_Picture Is Nothing) Then Exit Sub
  209.     With UserControl
  210.         .PaintPicture m_Picture, _
  211.                       .ScaleX(2, vbTwips, vbHimetric), _
  212.                       .ScaleY(2, vbTwips, vbHimetric), _
  213.                       .ScaleX(.Width - 4, vbTwips, vbHimetric), _
  214.                       .ScaleY(.Height - 4, vbTwips, vbHimetric), _
  215.                       0, _
  216.                       0, _
  217.                       m_Picture.Width, _
  218.                       m_Picture.Height
  219.     End With
  220. End Sub
  221. Private Sub DrawHands(MyTime As String)
  222.     Dim cHour As Integer
  223.     Dim cMinute As Integer
  224.     Dim cSecond As Integer
  225.     cHour = CInt(Mid(MyTime, 1, 2))
  226.     cMinute = CInt(Mid(MyTime, 3, 2))
  227.     cSecond = CInt(Mid(MyTime, 5, 2))
  228. '   Draw Hour Hand
  229.     With lHour
  230.         .X1 = HalfX
  231.         .Y1 = HalfY
  232.         .X2 = HalfX + GiveX((cHour Mod 12) * 5 + (Int(cMinute / 12)), HalfX, HourRatio)
  233.         .Y2 = HalfY - GiveY((cHour Mod 12) * 5 + (Int(cMinute / 12)), HalfY, HourRatio)
  234.     End With
  235. '   Draw Minute Hand
  236.     With lMinute
  237.         .X1 = HalfX
  238.         .Y1 = HalfY
  239.         .X2 = HalfX + GiveX(cMinute, HalfX, MinuteRatio)
  240.         .Y2 = HalfY - GiveY(cMinute, HalfY, MinuteRatio)
  241.     End With
  242. '   Draw Second Hand
  243.     With lSecond
  244.         .X1 = HalfX
  245.         .Y1 = HalfY
  246.         .X2 = HalfX + GiveX(cSecond, HalfX, SecondRatio)
  247.         .Y2 = HalfY - GiveY(cSecond, HalfY, SecondRatio)
  248.     End With
  249. End Sub
  250. Private Function GiveX(ByVal Angle As Integer, ByVal MaxX As Integer, ByVal Ratio As Single) As Integer
  251.     GiveX = MaxX * Ratio * Sin((Angle / 60) * TwoPI)
  252. End Function
  253. Private Function GiveY(ByVal Angle As Integer, ByVal MaxY As Integer, ByVal Ratio As Single) As Integer
  254.     GiveY = MaxY * Ratio * Cos((Angle / 60) * TwoPI)
  255. End Function
  256. Private Sub PlaceNumbers()
  257.     Dim tHeight As Integer
  258.     Dim tWidth As Integer
  259.     Dim WBorder As Integer
  260.     Dim HBorder As Integer
  261. '   Get largest font size that will fit in display label
  262.     tHeight = ScaleHeight * 0.1
  263.     WBorder = ScaleWidth * 0.035
  264.     HBorder = ScaleHeight * 0.02
  265.     FontSize = 1
  266.     While TextHeight("3") < tHeight
  267.         FontSize = FontSize + 1
  268.     Wend
  269. '   Since went to > tHeight, need to subtract 1
  270.     FontSize = FontSize - 1
  271.     With lblNumber(0)
  272.         .FontSize = FontSize
  273.         .Width = TextWidth("12")
  274.         .Height = TextHeight("12")
  275.         .Move HalfX - (.Width / 2), HBorder
  276.     End With
  277.     With lblNumber(1)
  278.         .FontSize = FontSize
  279.         .Width = TextWidth("3")
  280.         .Height = TextHeight("3")
  281.         .Move ScaleWidth - .Width - WBorder, HalfY - (.Height / 2)
  282.     End With
  283.     With lblNumber(2)
  284.         .FontSize = FontSize
  285.         .Width = TextWidth("6")
  286.         .Height = TextHeight("6")
  287.         .Move HalfX - (.Width / 2), ScaleHeight - .Height - HBorder
  288.     End With
  289.     With lblNumber(3)
  290.         .FontSize = FontSize
  291.         .Width = TextWidth("9")
  292.         .Height = TextHeight("9")
  293.         .Move WBorder, HalfY - (.Height / 2)
  294.     End With
  295. End Sub
  296. Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
  297.     If (AsyncProp.PropertyName = "URLPicture") Then Set Picture = AsyncProp.Value
  298. End Sub
  299. Public Property Get Enabled() As Boolean
  300.     Enabled = m_Enabled
  301. End Property
  302. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  303.     m_Enabled = New_Enabled
  304.     Timer1.Enabled = New_Enabled
  305. End Property
  306. Public Property Get ShowNumbers() As Boolean
  307.     ShowNumbers = m_ShowNumbers
  308. End Property
  309. Public Property Let ShowNumbers(ByVal New_ShowNumbers As Boolean)
  310.     m_ShowNumbers = New_ShowNumbers
  311.     lblNumber(0).Visible = New_ShowNumbers
  312.     lblNumber(1).Visible = New_ShowNumbers
  313.     lblNumber(2).Visible = New_ShowNumbers
  314.     lblNumber(3).Visible = New_ShowNumbers
  315.     UserControl_Resize
  316.     PropertyChanged "ShowNumbers"
  317. End Property
  318. Public Property Get ShowBorder() As Boolean
  319.     ShowBorder = m_ShowBorder
  320. End Property
  321. Public Property Let ShowBorder(ByVal New_ShowBorder As Boolean)
  322.     m_ShowBorder = New_ShowBorder
  323.     ClockFace.Visible = New_ShowBorder
  324. '   Have to repaint, since picture needs to be redrawn based on new border
  325.     If Not m_Picture Is Nothing Then
  326.         UserControl_Paint
  327.     End If
  328.     PropertyChanged "ShowBorder"
  329. End Property
  330. Public Property Get ShowSeconds() As Boolean
  331.     ShowSeconds = m_ShowSeconds
  332. End Property
  333. Public Property Let ShowSeconds(ByVal New_ShowSeconds As Boolean)
  334.     m_ShowSeconds = New_ShowSeconds
  335.     lSecond.Visible = New_ShowSeconds
  336.     PropertyChanged "ShowSeconds"
  337. End Property
  338. Public Property Get ColorBorder() As OLE_COLOR
  339.     ColorBorder = m_ColorBorder
  340. End Property
  341. Public Property Let ColorBorder(ByVal New_ColorBorder As OLE_COLOR)
  342.     m_ColorBorder = New_ColorBorder
  343.     ClockFace.BorderColor = New_ColorBorder
  344.     lHour.BorderColor = New_ColorBorder
  345.     lMinute.BorderColor = New_ColorBorder
  346.     lSecond.BorderColor = New_ColorBorder
  347.     lblNumber(0).ForeColor = New_ColorBorder
  348.     lblNumber(1).ForeColor = New_ColorBorder
  349.     lblNumber(2).ForeColor = New_ColorBorder
  350.     lblNumber(3).ForeColor = New_ColorBorder
  351.     PropertyChanged "ColorBorder"
  352. End Property
  353. Public Property Get ColorFace() As OLE_COLOR
  354.     ColorFace = m_ColorFace
  355. End Property
  356. Public Property Let ColorFace(ByVal New_ColorFace As OLE_COLOR)
  357.     m_ColorFace = New_ColorFace
  358.     With ClockFace
  359.         .FillColor = New_ColorFace
  360.         .FillStyle = 0
  361.         .Refresh
  362.     End With
  363.     PropertyChanged "ColorFace"
  364. End Property
  365. Public Property Get Picture() As StdPicture
  366.     Set Picture = m_Picture
  367. End Property
  368. Public Property Set Picture(New_Picture As StdPicture)
  369.     Set m_Picture = New_Picture
  370.     ColorBorder = m_def_ColorBorder
  371.     ColorFace = m_def_ColorFace
  372.     With ClockFace
  373.         .FillColor = 0
  374.         .FillStyle = 1
  375.         .Refresh
  376.     End With
  377.     UserControl.Picture = m_Picture
  378.     UserControl_Resize
  379.     PropertyChanged "Picture"
  380. End Property
  381. Public Property Let URLPicture(Url As String)
  382.     If (m_URLPicture <> Url) Then
  383.         m_URLPicture = Url
  384.         PropertyChanged "URLPicture"
  385.         
  386.         On Error Resume Next
  387.         
  388.         UserControl.AsyncRead Url, vbAsyncTypePicture, "URLPicture"
  389.     End If
  390. End Property
  391. Public Property Get URLPicture() As String
  392.     URLPicture = m_URLPicture
  393. End Property
  394. 'Load property values from storage
  395. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  396.     Dim Pic As StdPicture
  397.     Dim Url As String
  398.     With PropBag
  399.         m_Enabled = .ReadProperty("Enabled", m_def_Enabled)
  400.         m_ShowNumbers = .ReadProperty("ShowNumbers", m_def_ShowNumbers)
  401.         m_ShowBorder = .ReadProperty("ShowBorder", m_def_ShowBorder)
  402.         m_ShowSeconds = .ReadProperty("ShowSeconds", m_def_ShowSeconds)
  403.         m_ColorBorder = .ReadProperty("ColorBorder", m_def_ColorBorder)
  404.         m_ColorFace = .ReadProperty("ColorFace", m_def_ColorFace)
  405.         
  406.         Set Pic = .ReadProperty("Picture", Nothing)
  407.         Url = .ReadProperty("URLPicture", "")
  408.         
  409.         If (Url <> "") Then
  410.             URLPicture = Url
  411.         ElseIf Not (Pic Is Nothing) Then
  412.             Set Picture = Pic
  413.         End If
  414.     End With
  415. End Sub
  416. 'Write property values to storage
  417. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  418.     With PropBag
  419.         .WriteProperty "Enabled", m_Enabled, m_def_Enabled
  420.         .WriteProperty "ShowNumbers", m_ShowNumbers, m_def_ShowNumbers
  421.         .WriteProperty "ShowBorder", m_ShowBorder, m_def_ShowBorder
  422.         .WriteProperty "ShowSeconds", m_ShowSeconds, m_def_ShowSeconds
  423.         .WriteProperty "ColorBorder", m_ColorBorder, m_def_ColorBorder
  424.         .WriteProperty "ColorFace", m_ColorFace, m_def_ColorFace
  425.         .WriteProperty "Picture", m_Picture
  426.         .WriteProperty "URLPicture", m_URLPicture
  427.     End With
  428. End Sub
  429.